Filename | (eval 24)[/home/hejohns/perl5/lib/perl5/IPC/Run/Debug.pm:103] |
Statements | Executed 67130778 statements in 108s |
Eval Invoked At | /home/hejohns/perl5/lib/perl5/IPC/Run/Debug.pm line 103 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
8391346 | 3 | 1 | 37.8s | 54.4s | _debugging_atleast | IPC::Run::Debug::
6927931 | 25 | 2 | 31.1s | 76.8s | _debugging_details | IPC::Run::Debug::
8391346 | 1 | 1 | 16.5s | 16.5s | _debugging_level | IPC::Run::Debug::
1197323 | 8 | 1 | 4.11s | 9.94s | _debugging | IPC::Run::Debug::
266092 | 2 | 1 | 1.62s | 4.45s | _debugging_data | IPC::Run::Debug::
1 | 1 | 1 | 6µs | 6µs | BEGIN@2 | IPC::Run::Debug::
1 | 1 | 1 | 4µs | 15µs | BEGIN@25 | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _debug | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _debug_desc_fd | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _debug_init | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _debugging_gory_details | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _debugging_not_optimized | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _map_fds | IPC::Run::Debug::
0 | 0 | 0 | 0s | 0s | _set_child_debug_name | IPC::Run::Debug::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | |||||
2 | 2 | 92µs | 1 | 6µs | # spent 6µs within IPC::Run::Debug::BEGIN@2 which was called:
# once (6µs+0s) by IPC::Run::BEGIN@1052 at line 2 # spent 6µs making 1 call to IPC::Run::Debug::BEGIN@2 |
3 | |||||
4 | sub _map_fds { | ||||
5 | my $map = ''; | ||||
6 | my $digit = 0; | ||||
7 | my $in_use; | ||||
8 | my $dummy; | ||||
9 | for my $fd (0..63) { | ||||
10 | ## I'd like a quicker way (less user, cpu & especially sys and kernel | ||||
11 | ## calls) to detect open file descriptors. Let me know... | ||||
12 | ## Hmmm, could do a 0 length read and check for bad file descriptor... | ||||
13 | ## but that segfaults on Win32 | ||||
14 | my $test_fd = POSIX::dup( $fd ); | ||||
15 | $in_use = defined $test_fd; | ||||
16 | POSIX::close $test_fd if $in_use; | ||||
17 | $map .= $in_use ? $digit : '-'; | ||||
18 | $digit = 0 if ++$digit > 9; | ||||
19 | } | ||||
20 | warn "No fds open???" unless $map =~ /\d/; | ||||
21 | $map =~ s/(.{1,12})-*$/$1/; | ||||
22 | return $map; | ||||
23 | } | ||||
24 | |||||
25 | 2 | 410µs | 2 | 25µs | # spent 15µs (4+11) within IPC::Run::Debug::BEGIN@25 which was called:
# once (4µs+11µs) by IPC::Run::BEGIN@1052 at line 25 # spent 15µs making 1 call to IPC::Run::Debug::BEGIN@25
# spent 10µs making 1 call to vars::import |
26 | |||||
27 | 1 | 4µs | $parent_pid = $$; | ||
28 | |||||
29 | ## TODO: move debugging to its own module and make it compile-time | ||||
30 | ## optimizable. | ||||
31 | |||||
32 | ## Give kid process debugging nice names | ||||
33 | 1 | 100ns | my $debug_name; | ||
34 | |||||
35 | sub _set_child_debug_name { | ||||
36 | $debug_name = shift; | ||||
37 | } | ||||
38 | |||||
39 | ## There's a bit of hackery going on here. | ||||
40 | ## | ||||
41 | ## We want to have any code anywhere be able to emit | ||||
42 | ## debugging statements without knowing what harness the code is | ||||
43 | ## being called in/from, since we'd need to pass a harness around to | ||||
44 | ## everything. | ||||
45 | ## | ||||
46 | ## Thus, $cur_self was born. | ||||
47 | # | ||||
48 | 1 | 3µs | my %debug_levels = ( | ||
49 | none => 0, | ||||
50 | basic => 1, | ||||
51 | data => 2, | ||||
52 | details => 3, | ||||
53 | gore => 4, | ||||
54 | gory_details => 4, | ||||
55 | "gory details" => 4, | ||||
56 | gory => 4, | ||||
57 | gorydetails => 4, | ||||
58 | all => 10, | ||||
59 | notopt => 0, | ||||
60 | ); | ||||
61 | |||||
62 | 1 | 100ns | my $warned; | ||
63 | |||||
64 | # spent 16.5s within IPC::Run::Debug::_debugging_level which was called 8391346 times, avg 2µs/call:
# 8391346 times (16.5s+0s) by IPC::Run::Debug::_debugging_atleast at line 86, avg 2µs/call | ||||
65 | 8391346 | 921ms | my $level = 0; | ||
66 | |||||
67 | $level = $IPC::Run::cur_self->{debug} || 0 | ||||
68 | if $IPC::Run::cur_self | ||||
69 | 8391346 | 4.08s | && ( $IPC::Run::cur_self->{debug} || 0 ) >= $level; | ||
70 | |||||
71 | 8391346 | 1.93s | if ( defined $ENV{IPCRUNDEBUG} ) { | ||
72 | my $v = $ENV{IPCRUNDEBUG}; | ||||
73 | $v = $debug_levels{lc $v} if $v =~ /[a-zA-Z]/; | ||||
74 | unless ( defined $v ) { | ||||
75 | $warned ||= warn "Unknown debug level $ENV{IPCRUNDEBUG}, assuming 'basic' (1)\n"; | ||||
76 | $v = 1; | ||||
77 | } | ||||
78 | $level = $v if $v > $level; | ||||
79 | } | ||||
80 | 8391346 | 28.8s | return $level; | ||
81 | } | ||||
82 | |||||
83 | # spent 54.4s (37.8+16.5) within IPC::Run::Debug::_debugging_atleast which was called 8391346 times, avg 6µs/call:
# 6927931 times (31.6s+14.1s) by IPC::Run::Debug::_debugging_details at line 93, avg 7µs/call
# 1197323 times (4.52s+1.32s) by IPC::Run::Debug::_debugging at line 91, avg 5µs/call
# 266092 times (1.67s+1.16s) by IPC::Run::Debug::_debugging_data at line 92, avg 11µs/call | ||||
84 | 8391346 | 1.63s | my $min_level = shift || 1; | ||
85 | |||||
86 | 8391346 | 9.59s | 8391346 | 16.5s | my $level = _debugging_level; # spent 16.5s making 8391346 calls to IPC::Run::Debug::_debugging_level, avg 2µs/call |
87 | |||||
88 | 8391346 | 26.4s | return $level >= $min_level ? $level : 0; | ||
89 | } | ||||
90 | |||||
91 | 1197323 | 3.87s | 1197323 | 5.84s | # spent 9.94s (4.11+5.84) within IPC::Run::Debug::_debugging which was called 1197323 times, avg 8µs/call:
# 266072 times (919ms+1.11s) by IPC::Run::harness at line 1797 of IPC/Run.pm, avg 8µs/call
# 133036 times (459ms+943ms) by IPC::Run::harness at line 1788 of IPC/Run.pm, avg 11µs/call
# 133036 times (560ms+719ms) by IPC::Run::reap_nb at line 3486 of IPC/Run.pm, avg 10µs/call
# 133036 times (558ms+704ms) by IPC::Run::finish at line 3529 of IPC/Run.pm, avg 9µs/call
# 133036 times (412ms+609ms) by IPC::Run::start at line 2806 of IPC/Run.pm, avg 8µs/call
# 133036 times (414ms+542ms) by IPC::Run::reap_nb at line 3491 of IPC/Run.pm, avg 7µs/call
# 133036 times (349ms+563ms) by IPC::Run::_debug_fd at line 1128 of IPC/Run.pm, avg 7µs/call
# 133035 times (433ms+645ms) by IPC::Run::_search_path at line 1190 of IPC/Run.pm, avg 8µs/call # spent 5.84s making 1197323 calls to IPC::Run::Debug::_debugging_atleast, avg 5µs/call |
92 | 266092 | 1.23s | 266092 | 2.83s | # spent 4.45s (1.62+2.83) within IPC::Run::Debug::_debugging_data which was called 266092 times, avg 17µs/call:
# 133056 times (736ms+1.06s) by IPC::Run::_write at line 1485 of IPC/Run.pm, avg 13µs/call
# 133036 times (880ms+1.77s) by IPC::Run::_read at line 1430 of IPC/Run.pm, avg 20µs/call # spent 2.83s making 266092 calls to IPC::Run::Debug::_debugging_atleast, avg 11µs/call |
93 | 6927931 | 29.8s | 6927931 | 45.7s | # spent 76.8s (31.1+45.7) within IPC::Run::Debug::_debugging_details which was called 6927931 times, avg 11µs/call:
# 1602123 times (5.91s+8.21s) by IPC::Run::reap_nb at line 3476 of IPC/Run.pm, avg 9µs/call
# 666625 times (2.32s+3.42s) by IPC::Run::_select_loop at line 3043 of IPC/Run.pm, avg 9µs/call
# 666621 times (3.58s+6.50s) by IPC::Run::_select_loop at line 3140 of IPC/Run.pm, avg 15µs/call
# 666621 times (2.40s+3.20s) by IPC::Run::_select_loop at line 3091 of IPC/Run.pm, avg 8µs/call
# 532144 times (2.14s+5.06s) by IPC::Run::_close at line 1313 of IPC/Run.pm, avg 14µs/call
# 266092 times (1.08s+2.13s) by IPC::Run::IO::poll at line 522 of IPC/Run/IO.pm, avg 12µs/call
# 266072 times (835ms+1.13s) by IPC::Run::_dup at line 1321 of IPC/Run.pm, avg 7µs/call
# 133056 times (656ms+953ms) by IPC::Run::__ANON__[/home/hejohns/perl5/lib/perl5/IPC/Run.pm:2514] at line 2502 of IPC/Run.pm, avg 12µs/call
# 133036 times (5.57s+6.25s) by IPC::Run::_spawn at line 1453 of IPC/Run.pm, avg 89µs/call
# 133036 times (597ms+870ms) by IPC::Run::_clobber at line 2953 of IPC/Run.pm, avg 11µs/call
# 133036 times (400ms+721ms) by IPC::Run::_pipe_nb at line 1399 of IPC/Run.pm, avg 8µs/call
# 133036 times (515ms+601ms) by IPC::Run::harness at line 1909 of IPC/Run.pm, avg 8µs/call
# 133036 times (423ms+666ms) by IPC::Run::_open_pipes at line 2414 of IPC/Run.pm, avg 8µs/call
# 133036 times (507ms+539ms) by IPC::Run::_cleanup at line 3209 of IPC/Run.pm, avg 8µs/call
# 133036 times (386ms+626ms) by IPC::Run::start at line 2845 of IPC/Run.pm, avg 8µs/call
# 133036 times (445ms+545ms) by IPC::Run::_spawn at line 1442 of IPC/Run.pm, avg 7µs/call
# 133036 times (403ms+584ms) by IPC::Run::_pipe_nb at line 1408 of IPC/Run.pm, avg 7µs/call
# 133036 times (450ms+532ms) by IPC::Run::_cleanup at line 3270 of IPC/Run.pm, avg 7µs/call
# 133036 times (452ms+516ms) by IPC::Run::_pipe_nb at line 1405 of IPC/Run.pm, avg 7µs/call
# 133036 times (445ms+520ms) by IPC::Run::_pipe at line 1385 of IPC/Run.pm, avg 7µs/call
# 133036 times (423ms+525ms) by IPC::Run::_cleanup at line 3256 of IPC/Run.pm, avg 7µs/call
# 133036 times (421ms+519ms) by IPC::Run::_cleanup at line 3225 of IPC/Run.pm, avg 7µs/call
# 133036 times (388ms+543ms) by IPC::Run::_open_pipes at line 2175 of IPC/Run.pm, avg 7µs/call
# 133036 times (399ms+524ms) by IPC::Run::_cleanup at line 3230 of IPC/Run.pm, avg 7µs/call
# once (2µs+5µs) by IPC::Run::_search_path at line 1235 of IPC/Run.pm # spent 45.7s making 6927931 calls to IPC::Run::Debug::_debugging_atleast, avg 7µs/call |
94 | sub _debugging_gory_details() { _debugging_atleast 4 } | ||||
95 | sub _debugging_not_optimized() { ( $ENV{IPCRUNDEBUG} || "" ) eq "notopt" } | ||||
96 | |||||
97 | sub _debug_init { | ||||
98 | ## This routine is called only in spawned children to fake out the | ||||
99 | ## debug routines so they'll emit debugging info. | ||||
100 | $IPC::Run::cur_self = {}; | ||||
101 | ( $parent_pid, | ||||
102 | $^T, | ||||
103 | $IPC::Run::cur_self->{debug}, | ||||
104 | $IPC::Run::cur_self->{DEBUG_FD}, | ||||
105 | $debug_name | ||||
106 | ) = @_; | ||||
107 | } | ||||
108 | |||||
109 | |||||
110 | sub _debug { | ||||
111 | # return unless _debugging || _debugging_not_optimized; | ||||
112 | |||||
113 | my $fd = defined &IPC::Run::_debug_fd | ||||
114 | ? IPC::Run::_debug_fd() | ||||
115 | : fileno STDERR; | ||||
116 | |||||
117 | my $s; | ||||
118 | my $debug_id; | ||||
119 | $debug_id = join( | ||||
120 | " ", | ||||
121 | join( | ||||
122 | "", | ||||
123 | defined $IPC::Run::cur_self && defined $IPC::Run::cur_self->{ID} | ||||
124 | ? "#$IPC::Run::cur_self->{ID}" | ||||
125 | : (), | ||||
126 | "($$)", | ||||
127 | ), | ||||
128 | defined $debug_name && length $debug_name ? $debug_name : (), | ||||
129 | ); | ||||
130 | my $prefix = join( | ||||
131 | "", | ||||
132 | "IPC::Run", | ||||
133 | sprintf( " %04d", time - $^T ), | ||||
134 | ( _debugging_details ? ( " ", _map_fds ) : () ), | ||||
135 | length $debug_id ? ( " [", $debug_id, "]" ) : (), | ||||
136 | ": ", | ||||
137 | ); | ||||
138 | |||||
139 | my $msg = join( '', map defined $_ ? $_ : "<undef>", @_ ); | ||||
140 | chomp $msg; | ||||
141 | $msg =~ s{^}{$prefix}gm; | ||||
142 | $msg .= "\n"; | ||||
143 | POSIX::write( $fd, $msg, length $msg ); | ||||
144 | } | ||||
145 | |||||
146 | |||||
147 | 1 | 500ns | my @fd_descs = ( 'stdin', 'stdout', 'stderr' ); | ||
148 | |||||
149 | sub _debug_desc_fd { | ||||
150 | return unless _debugging; | ||||
151 | my $text = shift; | ||||
152 | my $op = pop; | ||||
153 | my $kid = $_[0]; | ||||
154 | |||||
155 | Carp::carp join " ", caller(0), $text, $op if defined $op && UNIVERSAL::isa( $op, "IO::Pty" ); | ||||
156 | |||||
157 | _debug( | ||||
158 | $text, | ||||
159 | ' ', | ||||
160 | ( defined $op->{FD} | ||||
161 | ? $op->{FD} < 3 | ||||
162 | ? ( $fd_descs[$op->{FD}] ) | ||||
163 | : ( 'fd ', $op->{FD} ) | ||||
164 | : $op->{FD} | ||||
165 | ), | ||||
166 | ( defined $op->{KFD} | ||||
167 | ? ( | ||||
168 | ' (kid', | ||||
169 | ( defined $kid ? ( ' ', $kid->{NUM}, ) : () ), | ||||
170 | "'s ", | ||||
171 | ( $op->{KFD} < 3 | ||||
172 | ? $fd_descs[$op->{KFD}] | ||||
173 | : defined $kid | ||||
174 | && defined $kid->{DEBUG_FD} | ||||
175 | && $op->{KFD} == $kid->{DEBUG_FD} | ||||
176 | ? ( 'debug (', $op->{KFD}, ')' ) | ||||
177 | : ( 'fd ', $op->{KFD} ) | ||||
178 | ), | ||||
179 | ')', | ||||
180 | ) | ||||
181 | : () | ||||
182 | ), | ||||
183 | ); | ||||
184 | } | ||||
185 | |||||
186 | 1 | 4µs | 1; | ||
187 | |||||
188 | |||||
189 | ; |